perm filename DRAWSM.F4[MSS,LCS]1 blob
sn#078119 filedate 1974-01-08 generic text, type T, neo UTF8
00100 SUBROUTINE DRAWIT
00105 DIMENSION BUF2(1000)
00110 COMMON XX(100),YY(100),NQ,X1(512),Y1(512),SX(100),KG
00200 COMMON/ED/K,NEXT,NN,NX,NY,J
00300 COMMON /RZ/RSZ,IPLT,RJB,CENTR
00400 COMMON /RC/MCLEF(200),IST(4000),MFILL(200)
00500 COMMON/ZN/SCLEF(200,2),DDD
00600 COMMON/LL/LL
00610 COMMON/JJJ/JJJ
00700 EQUIVALENCE(MM,SCLEF(1,1)),(W,IST(4000)),(BUF2,IST(3001))
00800 DATA RN/15./,RND/0.5/
00900 CALL ACCPOG(1)
01000 C DISPLAYS OLD ITEM WITHOUT FILLER
01100 CALL DPYOUT(1)
01200 REL=-1
01300 JC=0
01400 W=-1
01500 KE=-1
01600 JCL=0
01700 RJ=1
01800 JF=0
01900 IF(MM.EQ.0)GO TO 20
02000 J=MM
02100 JX=-1
02200 JCL=MM
02300 NX=SCLEF(MM,1)
02400 NY=SCLEF(MM,2)
02500 GO TO 120
02600 20 IF(JF.EQ.0)J=1
02900 JZ=J
03200 2 NX=RJB*RSZ
03300 NY=CENTR*RSZ
03500 121 JX=0
03600 120 NZ=-1
03700 JC=1
03800 RL=NX
03900 RM=NY
04000 C L AND M ARE USED AS CONSTANTS WHEN RESETTING CURSOR
04100 44 CALL SETCUR(NX,NY,0)
04200 83 S=0
04300 4 IF(S)GO TO 81
04320 IF(K.EQ.'E')GO TO 700
04360 C BYPASS FOR EDITING.
04400 TYPE 45
04500 ACCEPT 144,K,ZK,KK
04600 IF(ZK.NE.'E')GO TO 344
04700 REL=0
04800 C TYPE REL FOR RELATIVE VECTORS, O=ORDINARY
04900 GO TO 4
05000 344 IF(K.NE.'O')GO TO 244
05100 REL=-1
05200 GO TO 4
05300 144 FORMAT(3A1)
05315 244 IF(ZK.NE.'M')GO TO 444
05316 C TYPE SM TO SMOOTH, SMX=ERASE STRAIGHT LINES TEMPORARILY.
05317 CALL SMOOTH(KK)
05318 GO TO 4
05400 444 REREAD 1,K,ZK,XK
05500 IF(K.LE.' ')GO TO 40
05600 REREAD 11,RJ,RK,XK
05700 JMPR=0
05800 IF(XK.NE.0)K='J'
05900 C TYPE 3RD NUM=1 FOR JUMPS
06000 41 QJ=RJ
06100 QK=RK
06200 IF(REL)GO TO 141
06300 241 X=X+QJ*RSZ
06400 Y=Y+QK*RSZ
06500 NX=X
06600 NY=Y
06700 GO TO 48
06800 141 NX=GTPT(RJ,RJB)
06900 NY=GTPT(RK,CENTR)
07000 X=NX
07100 Y=NY
07200 GO TO 481
07300 40 KK=ZK
07400 C B=BACKUP, J=JUMP, CR=SET POINT, X=EXIT, LRUD-N
07500 C F=FILL IT, H=GO TO HOME-NUM, N=GO TO NEXT(AFTER AN 'H')
07600 C Z=ZERO IN ON NEARBY POINT, P=GO TO PREVIOUS, C=CLOSE THE AREA
07700 C D=EXTEND DRAWING, F=START FILLER OUTLINE, SM=SMOOTH IT
07800 C TYPE 'F' FOR EACH AREA TO BE FILLED
07900 IF(ZK.NE.0)NZ=-1
08000 C WILL STAY IN "Z" MODE UNLESS NUMBER APPEARS.
08100 JMPR=0
08200 JCX=2
08300 C JCX IS FOR "ZEROING-IN" SECTION AND EDIT SECTION
08400 C FOR SHIFTS OF "JUMPS"
08500 IF(K.EQ.'B')GO TO 22
08600 IF(K.EQ.'P')GO TO 56
08700 IF(K.EQ.'C')GO TO 51
08800 IF(K.EQ.'H')GO TO 52
08900 IF(K.EQ.'X'.OR.K.EQ.'F')GO TO 3
09000 IF(K.EQ.' '.OR.K.EQ.'J'.OR.K.EQ.'Z')GO TO 47
09100 IF(K.EQ.'S')GO TO 79
09200 IF(K.NE.'N')GO TO 7
09300 55 KK=NEXT
09400 GO TO 52
09500 56 KK=NEXT-2
09600 52 IF(KK.LE.1)KK=2
09700 X=SCLEF(KK,1)
09800 Y=SCLEF(KK,2)
09900 NEXT=KK+1
10000 IF(KE)GO TO 48
10100 RX=X
10200 RY=Y
10210 58 CALL ITYP
10300 CALL EDTYP(K,X,JJJ)
10600 C TYPE "A" OR ":" TO ALTER
10800 C TYPE "G"=GROUP CHANGE) TO MAKE RELATIVE CHANGE STICK
10850 C , THEN <CR>S. ANY OTHER LETTER TO ESCAPE
11100 570 IF(K.EQ.' '.AND.S)GO TO 81
11300 IF(K.EQ.'S')GO TO 82
11400 C S=STEP AHEAD(N) (-N GOES BACK)
11500 IF(K.EQ.'X')GO TO 44
11600 IF(W)MCLEF(1)=J
11700 IF(W.EQ.0)MFILL(1)=J
11800 571 CALL DREDIT
12100 59 X=RX
12200 Y=RY
12300 KE=-1
12320 NX=0
12340 NY=0
12400 GO TO 170
12500 C THIS WRECKS "CLOSE"
12600 47 IF(REL.EQ.0)GO TO 22
12700 C IF IN "REL" MODE TYPE "O" BEFORE USING LTPEN
12800 CALL RDCUR(NX,NY)
12900 X=NX
13000 Y=NY
13100 IF(K.NE.'Z'.AND.NZ)GO TO 48
13200 NZ=0
13300 DO 54 K=JCX,JCL
13400 IF(ABS(SCLEF(K,1)-X).GT.RN.OR.ABS(SCLEF(K,2)-Y).GT.RN)
13500 1 GO TO 54
13600 KK=K
13700 GO TO 52
13800 54 CONTINUE
13900 IF(KE)GO TO 48
14000 TYPE 154
14100 GO TO 4
14200 154 FORMAT(' NO POINT FOUND ')
14400 C ABOVE FOR INITIAL MOVEMENT OF CURSOR
14500 51 X=RX
14600 Y=RY
14700 48 RJ=STPT(X,RJB)
14800 RK=STPT(Y,CENTR)
14900 481 SK=RK
15000 J=J+1
15100 SJ=RJ
15200 C DO I NEED RJ,RK ANYWHERE?? YES - AT REPACK
15300 451 LL=0
15400 IF(K.EQ.'J')LL=3
15500 C J=JUMP
15600 IJ=RJ
15700 IK=RK
15800 IF(JF)GO TO 49
15900 JCL=J
16000 CALL REPACK(J,IJ,IK,MCLEF)
16100 IF(MCLEF(J).NE.MCLEF(J-1).OR.J.EQ.2)GO TO 60
16200 61 J=J-1
16300 GO TO 4
16400 60 SCLEF(J,1)=X
16500 SCLEF(J,2)=Y
16600 GO TO 50
16700 49 CALL REPACK(J,IJ,IK,MFILL)
16800 IF(MFILL(J).EQ.MFILL(J-1).AND.J.NE.2)GO TO 61
16900 50 N=IST(2)
17000 X=GTPT(SJ,RJB)
17100 Y=GTPT(SK,CENTR)
17200 NX=X
17300 NY=Y
17400 IF(K.EQ.'B')GO TO 5
17500 IF(K.EQ.'J'.OR.JMPR.OR.JX.EQ.0)GO TO 6
17600 CALL AVECT(NX,NY)
17700 GO TO 5
17800 6 CALL AIVECT(NX,NY)
17900 JX=-1
18000 JMPR=-1
18200 C KZ IS FOR "CLOSE IT"
18300 NZ=-1
18400 RX=X
18500 RY=Y
18600 5 CALL DPYOUT(1)
18700 TYPE 46,J,SJ,SK
18800
18900 170 CALL SETCUR(NX,NY,JC)
19000 GO TO 4
19010 72 FORMAT(' EDIT O(UTLINE) OR F(ILLER)? ',$)
19020 74 FORMAT(' S(TEP) OR L(IGHT PEN)? ',$)
19100 7 IF(K.NE.'E')GO TO 8
19200 C E=EDIT
19210 700 TYPE 72
19220 ACCEPT 1,K
19230 IF(K.EQ.'F')GO TO 73
19240 TYPE 74
19250 ACCEPT 1,K,X
19260 IF(K.NE.'L')GO TO 79
19300 IF(ZK.NE.0)JCX=ZK
19400 C SETS "ZEROING-IN" FIRST COUNTER
19500 NZ=0
19600 KE=0
19700 TYPE 70
19800 GO TO 44
19900 70 FORMAT(' CHOOSE A POINT ')
20000 8 IF(K.NE.'W')GO TO 71
20100 73 NN=ZK
20150 JF=-1
20200 IF(MFILL(1).GT.0)CALL EDFILL
20210 IF(K.EQ.'F')GO TO 341
20220 C TO ADD ON TO FILLER: TYPE "E <CR>, F <CR>, F<CR>
20300 K='X'
20400 C ALWAYS EXITS AFTER FILL-EDIT
20500 GO TO 34
20600 71 IF(ZK.EQ.0)ZK=1
20700 IF(K.EQ.'L'.OR.K.EQ.'D')ZK=-ZK
20900 IF(K.EQ.'L'.OR.K.EQ.'R')GO TO 77
21000 SK=ZK+SK
21100 Y=GTPT(SK,CENTR)
21200 GO TO 78
21300 77 SJ=ZK+SJ
21400 X=GTPT(SJ,RJB)
21500 78 IST(2)=IST(2)-1
21600 CALL HYDPOG(1)
21700 CALL ACCPOG(1)
21800 GO TO 451
21900 79 S=-1
22000 JA=ZK-1
22100 84 IF(JA.LT.2)JA=1
22200 81 IF(K.NE.'D')JA=JA+1
22300 X=SCLEF(JA,1)
22400 Y=SCLEF(JA,2)
22500 NX=X
22600 NY=Y
22700 NEXT=JA+1
22800 CALL SETCUR(NX,NY,0)
22900 GO TO 58
23000 82 IF(X.EQ.0)X=-1
23100 JA=JA-1+X
23200 GO TO 84
23300 22 IF(J.EQ.JZ)GO TO 4
23400 C CAN'T BACKUP PAST 1 OR 'F'
23500 J=J-1
23600 IF(JF)GO TO 122
23700 CALL UNPACK(J,IJ,IK,MCLEF)
23800 GO TO 222
23900 122 CALL UNPACK(J,IJ,IK,MFILL)
24000 222 IST(2)=IST(2)-1
24100 SJ=IJ
24200 SK=IK
24300 CALL HYDPOG(1)
24400 CALL ACCPOG(1)
24500 IF(K.EQ.'B')GO TO 50
24600 RJ=RJ+QJ
24700 RK=RK+QK
24800 GO TO 241
24900 3 IF(JF.NE.0)GO TO 33
25000 MCLEF(1)=J
25100 IF(MCLEF(2).LT.100000000)MCLEF(2)=MCLEF(2)+100000000
25200 GO TO 34
25300 33 MFILL(JZ)=J
25400 MFILL(1)=J
25500 34 CALL CLRCUR
25700 IF(K.EQ.'X')RETURN
25800 341 JF=JF-1
25900 JZ=J
26000 IF(JF.NE.-1)GO TO 340
26100 J=1
26200 JZ=0
26300 340 J=J+1
26400 JZ=JZ+1
26500 MFILL(J)=1000
26600 C SO REPEAT TRAP IS BYPASSED WHEN 'F' IS TYPED
26700 JX=0
26800 C FOR INVISIBLE VECTOR.
26900 JC=0
27000 GO TO 20
27100 1 FORMAT(A1,2F)
27200 11 FORMAT(3F)
27300 46 FORMAT(I3,'.)',2F6.0/)
27400 45 FORMAT(' <CR> SETS POINT ',$)
27500 END